home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CU Amiga Super CD-ROM 18
/
CU Amiga Magazine's Super CD-ROM 18 (1997)(EMAP Images)(GB)[!][issue 1998-01].iso
/
CUCD
/
Magazine
/
WiredWorld
/
THOR_2.5_upgrade
/
rexx
/
HeaderManager.thor
< prev
next >
Wrap
Text File
|
1997-09-08
|
12KB
|
383 lines
/*
$VER: HeaderManager.thor 1.15 (5.1.97)
(c) Neil Bothwick <neil@wirenet.co.uk> 1997
*/
/* Adds, edits and deletes header lines in Thor events */
/* Thanks to ForwardMsg.thor by Petter Nilsen for some */
/* of the user database code */
options results
/* ;;;needs THOR and bbsread.library functions */
thorport = address()
if left(thorport,5) ~= 'THOR.' then do
say 'Headers.thor must be run from within Thor.'
end
if ~show('p', 'BBSREAD') then do
address command
'run >nil: `GetEnv THOR/THORPath`bin/LoadBBSRead'
'WaitForPort BBSREAD'
end
;;;
/* ;;;Set up some stuff */
Changed = 0
drop Menu. HdrMenu.
Menu.1 = '""'
Menu.2 = '"Add new header"'
Menu.3 = '""'
Menu.4 = '"Save and exit"'
Menu.5 = '""'
Menu.6 = '"HELP"'
Menu.Count = 6
HdrMenu.1 = 'Cc:'
HdrMenu.2 = 'Bcc:'
HdrMenu.3 = 'Followup-To:'
HdrMenu.4 = 'Reply-To:'
HdrMenu.5 = 'Custom'
HdrMenu.Count = 5
ThorPath = pragma('D')
;;;
/* ;;;Read system details */
address(thorport)
drop GLOBALCFG. CURRENT. BBS.
GETGLOBALCONFIG stem GLOBALCFG
CURRENTSYSTEM stem CURRENT
System = CURRENT.BBSNAME
address(bbsread)
GETBBSDATA bbsname '"'System'"' stem BBS
MailAddr = BBS.EMAILADDR
DataPath = BBS.BBSPATH
;;;
/* ;;;Get number of selected event */
address(thorport)
GETSELECTEDEVENT
if(rc ~= 0) then do
address(thorport)
errstring = THOR.LASTERROR
if RC = 5 then errstring = 'Event window not open'
call ExitMsg(errstring)
end
EventNo = result
;;;
/* ;;;Get event details */
address(bbsread)
READBREVENT '"'System'"' eventnr EventNo datastem EVENTDATA tagsstem EVENTTAGS
if RC > 0 then call ExitMsg(BBSREAD.LASTERROR)
if (EVENTDATA.EVENTTYPE > 1) & (EVENTDATA.EVENTTYPE ~= 9) then call ExitMsg('You can only edit the headers\nfor an Enter, Reply or Forward event')
MsgFile = DataPath||EVENTTAGS.MSGFILE
if pos('.',EVENTTAGS.CONFERENCE) > 0 then IsNews = 1
else IsNews = 0
;;;
/* ;;;Main loop */
call ReadHeaders
do until StopEdit = 1
StopEdit = MainMenu()
end
address(thorport)
if Changed = 1 then REQUESTNOTIFY '"You have changed some headers.\nDo you want to save them before exiting?"' '"_Yes|_No"'
if RC = 30 then call ExitMsg(THOR.LASTERROR)
if result = 1 then call WriteHeaders
;;;
exit
/* ;;;Show messages to user */
ShowMsg:
OldAddr = address()
address(thorport)
parse arg MsgStr
REQUESTNOTIFY '"'MsgStr'"' '" OK "'
address(OldAddr)
return
;;;
/* ;;;Exit with a message */
ExitMsg:
parse arg errmsg
call ShowMsg(errmsg)
exit
;;;
/* ;;;Show main menu */
MainMenu:
address(thorport)
do i = 1 to Menu.Count
interpret 'Header.'NowHeaders+i '=' Menu.i
end
Header.Count = NowHeaders + Menu.Count
REQUESTLIST instem Header SIZEGADGET title '"Headers in current message"'
if RC = 30 then call ExitMsg(THOR.LASTERROR)
option = result
if RC = 5 then return 1
select
when option = '' then nop
when option = 'Add new header' then call AddHeader
when option = 'Save and exit' then do
call WriteHeaders
return 1
end
when option = 'HELP' then do
address command 'MultiView `GetEnv THOR/THORPath`docs/HeaderManager.guide PUBSCREEN' GLOBALCFG.PUBSCREENNAME
end
otherwise do
/* Get number of header selected */
HdrNo = 0
do i = 1 to NowHeaders
if Header.i = option then HdrNo = i
end
REQUESTNOTIFY '"'option'\n\nEdit or Delete this header?"' '"_Edit|_Delete"'
if RC > 0 then ExitMsg(THOR.LASTERROR)
if result = 1 then call EditHeader
else call DeleteHeader
end
end
return 0
;;;
/* ;;;Read headers in current event */
ReadHeaders:
address(thorport)
if ~open(msg,MsgFile,'R') then call ExitMsg('Failed to open message file')
n = 0
drop Header.
Header.Count = 0
do until eof(msg)
NextLine = readln(msg)
if length(NextLine)=0 | right(word(NextLine,1),1) ~= ':' then leave
n = n + 1
Header.n = NextLine
Header.Count = n
end
call close(msg)
MsgHeaders = Header.Count
NowHeaders = Header.Count
return
;;;
/* ;;;Update message file with new headers */
WriteHeaders:
address(thorport)
OutFile = 'T:ThorHeaders.'time(s)
if ~open(msg,MsgFile,'R') then call ExitMsg('Failed to open message file')
if ~open(out,OutFile,'W') then call ExitMsg('Failed to open temporary file')
do i = 1 to MsgHeaders
call readln(msg)
end
do i = 1 to NowHeaders
call writeln(out,Header.i)
end
if MsgHeaders = 0 & NowHeaders > 0 then call writeln(out,'')
do until eof(msg)
block = readch(msg, 1048576)
call writech(out,block)
end
call close(out)
call close(msg)
address command 'copy' OutFile MsgFile
address command 'delete >NIL:' OutFile
Changed = 0
return
;;;
/* ;;;Add a new header */
AddHeader:
REQUESTLIST instem HdrMenu SIZEGADGET title '"Choose header to add"'
if RC = 30 then call ExitMsg(THOR.LASTERROR)
if RC = 5 then return
Hdr = result
select
when Hdr = 'Cc:' then do
if IsNews = 0 then call GetAddress
else do
call ShowMsg('Cc: headers not allowed in news')
Hdr = ''
end
end
when Hdr = 'Bcc:' then do
Hdr = 'bcc:'
if IsNews = 0 then call GetAddress
else do
call ShowMsg('Bcc: headers not allowed in news')
Hdr = ''
end
end
when Hdr = 'Followup-To:' then do
if IsNews = 1 then call GetConf
else do
call ShowMsg('Followup-To: headers not allowed in mail')
Hdr = ''
end
end
when Hdr = 'Reply-To:' then do
call GetAddress
end
when Hdr = 'Custom' then do
REQUESTSTRING title '"Add header"' body '"Enter custom header"' bt '" OK |Cancel"' id '"X-"'
if RC = 0 then Hdr = result
else Hdr = ''
end
otherwise nop
end
if Hdr > '' then do
NowHeaders = NowHeaders + 1
Header.Count = NowHeaders
Header.NowHeaders = Hdr
Changed = 1
end
return
;;;
/* ;;;Edit a header */
EditHeader:
HdrType = upper(word(Header.HdrNo,1))
Hdr = ''
select
when HdrType = 'CC:' then do
Hdr = 'cc:'
call GetAddress(subword(Header.HdrNo,2))
end
when HdrType = 'BCC:' then do
Hdr = 'bcc:'
call GetAddress(subword(Header.HdrNo,2))
end
when HdrType = 'FOLLOWUP-TO:' then do
Hdr = 'Followup-To:'
call GetConf(subword(Header.HdrNo,2))
end
when HdrType = 'REPLY-TO:' then do
Hdr = 'Reply-To:'
call GetAddress(subword(Header.HdrNo,2))
end
otherwise do
REQUESTSTRING title '"Edit header"' body '"Editing 'Header.HdrNo'"' bt '" OK |Cancel"' id '"'Header.HdrNo'"'
if RC = 0 then Hdr = result
end
end
if Hdr ~= '' then do
Header.HdrNo = Hdr
Changed = 1
end
return
;;;
/* ;;;Delete a header */
DeleteHeader:
do i = HdrNo to NowHeaders-1
interpret 'Header.i = Header.'i+1
end
NowHeaders = NowHeaders - 1
Changed = 1
return
;;;
/* ;;;Ask for an email address */
GetAddress:
parse arg default
if default > '' then OldHdr = Hdr default /* Backup original header */
else OldHdr = ''
REQUESTSTRING title '"Address header"' body '"Enter email address(es)"' bt '" _OK |_Cancel"' id '"'default'"' maxchars 200
if RC = 30 then ExitMsg(THOR.LASTERROR)
if RC = 5 then do /* If nothing entered */
Hdr = OldHdr
return
end
UserName = result
UserAddr = ''
drop USERS. SUG.
address(bbsread)
SEARCHBRUSER bbsname '"'System'"' stem USERS search '"'UserName'"' name address alias suggestusersstem SUG
if RC = 30 then call ExitMsg(BBSREAD.LASTERROR)
Found = result
if Found > 0 then do /* Match(es) found */
drop LIST.
drop USERTAGS.
LIST.COUNT = USERS.COUNT
do i = 1 to USERS.COUNT /* Build a list of user names */
LIST.i.USERNR = USERS.i.USERNR
READBRUSER bbsname '"'System'"' usernr USERS.i.USERNR tagsstem USERTAGS
if RC > 0 then call ExitMsg(BBSREAD.LASTERROR)
LIST.i = USERTAGS.NAME
if(symbol("USERTAGS.ADDRESS") = "VAR") then LIST.i.ADDRESS = USERTAGS.ADDRESS
end
address(thorport) /* Select a user */
drop UserName.
REQUESTLIST instem LIST outstem USERS title '"Select user:"' dragselect
if RC = 30 then call ExitMsg(THOR.LASTERROR)
do j = 1 to USERS.COUNT
do i = 1 to LIST.COUNT /* Check for email addresses */
if LIST.i = USERS.j then UserAddr = UserAddr','LIST.i.ADDRESS
end
end
end
else do /* No exact match found */
if(symbol("SUG.COUNT") = "VAR") then do
address(thorport)
drop USERS. UserNum.
REQUESTLIST instem SUG outstem USERS title '"Select user:"' dragselect
if RC = 30 then call ExitMsg(THOR.LASTERROR)
if RC = 5 then do /* If cancelled, use address as typed */
Hdr = Hdr UserName
return
end
do j = 1 to USERS.COUNT
do i = 1 to SUG.COUNT /* Get the user number */
if SUG.i = USERS.j then UserNum.j = SUG.i.USERNR
end
end
address(bbsread) /* Get data on users selected */
do i = 1 to USERS.COUNT
drop USERTAGS.
READBRUSER bbsname '"'System'"' usernr UserNum.i tagsstem USERTAGS
if RC > 0 then call ExitMsg(BBSREAD.LASTERROR)
if(symbol("USERTAGS.ADDRESS") = "VAR") then UserAddr = UserAddr','USERTAGS.ADDRESS
end
end
else do /* No users found in search */
call ShowMsg('No matching users found')
UserAddr = ''
Hdr = OldHdr
end
end
if left(UserAddr,1) = ',' then UserAddr = substr(UserAddr,2)
if UserAddr > '' then Hdr = Hdr UserAddr
else Hdr = ''
return
;;;
/* ;;;Ask for a conference name */
GetConf:
parse arg default
if default > '' then OldHdr = Hdr default /* Backup original header */
else OldHdr = ''
address(bbsread)
drop CONFS. SELECTED.
GETCONFLIST bbsname '"'System'"' stem CONFS
if RC = 30 then call ExitMsg(BBSREAD.LASTERROR)
address(thorport)
REQUESTLIST instem CONFS outstem SELECTED title '"Select newsgroup(s)"' dragselect
select
when RC = 30 then call ExitMsg(THOR.LASTERROR)
when RC = 5 then Hdr = OldHdr
otherwise do
Conf = ''
do i = 1 to SELECTED.COUNT
if upper(SELECTED.i) = 'EMAIL' then SELECTED.i = 'poster'
Conf = Conf','SELECTED.i
end
Hdr = Hdr substr(Conf,2)
end
end
return
;;;